perm filename BM[NEW,LCS]1 blob
sn#355410 filedate 1978-05-17 generic text, type T, neo UTF8
1) BEAMS.OL2[NEW,LCS] and 2) BX.F4[NEW,LCS] 5-17-78 12:46 pages 1,1
**** File 1) BEAMS.OL2[NEW,LCS], Page 1 line 1
1) C**** BEAMS, NREST ***********
1) SUBROUTINE BEAMS
**** File 2) BX.F4[NEW,LCS], Page 1 line 1
2) COMMENT ⊗ VALID 00002 PAGES
2) C REC PAGE DESCRIPTION
2) C00001 00001
2) C00002 00002 SUBROUTINE BEAMS
2) C00023 ENDMK
2) C⊗;
2) SUBROUTINE BEAMS
***************
**** File 1) BEAMS.OL2[NEW,LCS], Page 1 line 9
1) 1 /LIMIT/LIMIT,ITEM,LL,IS,IX
1) 1 /SCM/V(78),I,LCNT,STAFF,LIST(200),REND
**** File 2) BX.F4[NEW,LCS], Page 2 line 8
2) 1 /LIMIT/LIMIT,ITEM,LL,IS,IX /DPY/ST(3900),RHY(100)
2) 1 /SCM/V(78),I,LCNT,STAFF,LIST(200),REND
***************
**** File 1) BEAMS.OL2[NEW,LCS], Page 1 line 13
1) 1 ,IXX,ISEMI,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA
1) CC DATA BX/25./,BY/.5/,DFAC/6./,CURV/0.9/
1) C THESE ARE USED TO DETERMINE CURVE OF SLURS AT 63 (21700)
1) IF(RMODE.LT.500)GO TO 251
1) IF(MODE.EQ.4)RETURN
1) C PICKS UP SLURS ONLY WHEN USING SUBR. 'EXTRA' *********
1) 251 INVT=-1
1) LS=IS
**** File 2) BX.F4[NEW,LCS], Page 2 line 12
2) 1 ,JXX,ISEMI,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA
2) IF(MODE-4)33,44,555
2) 33 CALL MX
2) RETURN
2) 555 CALL SX
2) RETURN
2) 44 IF(RMODE.GE.500)RETURN
2) C PICKS UP SLURS ONLY WHEN USING SUBR. 'EXTRA' *********
2) INVT=-1
2) LS=IS
***************
**** File 1) BEAMS.OL2[NEW,LCS], Page 1 line 24
1) IF(MODE.NE.4)JNTC=JNTC-1
1) BEAMS.OL2[NEW,LCS] and 2) BX.F4[NEW,LCS] 5-17-78 12:46 pages 1,2
1) C JNTC=NUM OF NTS NOW
1) IF(MODE.EQ.3)GO TO 25
1) IF(REND.NE.0)GO TO 25
1) REND=3
**** File 2) BX.F4[NEW,LCS], Page 2 line 25
2) J=0
2) A=-1.
2) DO 1125 K=1,IZ
2) IF(R(1,K).GT.2)GO TO 1125
2) C GET BACK RHYTH. INFO IN P9 OF NOTES (FOR JDIF, COMPOSITE BEAMS)
2) B=R(3,K)
2) IF(A.EQ.B)GO TO 1125
2) C SKIP CHORD NOTES.
2) A=B
2) J=J+1
2) RHY(K)=V(J)
2) 1125 CONTINUE
2) 125 IF(REND.NE.0)GO TO 25
2) REND=3
***************
**** File 1) BEAMS.OL2[NEW,LCS], Page 1 line 80
1) CC IF(NOTAIL(X))NL=NR
1) 2022 IF(NR.EQ.IRHY)GO TO 422
**** File 2) BX.F4[NEW,LCS], Page 2 line 90
2) 2022 IF(NR.EQ.IRHY)GO TO 422
***************
**** File 1) BEAMS.OL2[NEW,LCS], Page 1 line 85
1) CC***822 IF(NR-NL-NN-N.GE.0)GO TO 322
1) 822 IF(NR-NL-NN-N.GT.0)GO TO 322
1) C IGNORE IF ONLY ONE NOTE FILLS UNIT
1) CC N=NN+N
1) C UPDATE REST AND GRACE COUNTER
1) 722 IF(NR.EQ.IRHY)GO TO 422
**** File 2) BX.F4[NEW,LCS], Page 2 line 94
2) 822 IF(NR-NL-NN-N.GT.0)GO TO 322
2) C IGNORE IF ONLY ONE NOTE FILLS UNIT
2) 722 IF(NR.EQ.IRHY)GO TO 422
***************
**** File 1) BEAMS.OL2[NEW,LCS], Page 1 line 170
1) 505 L=0
**** File 2) BX.F4[NEW,LCS], Page 2 line 176
2) JDIF=0
1) BEAMS.OL2[NEW,LCS] and 2) BX.F4[NEW,LCS] 5-17-78 12:46 pages 1,2
2) 505 L=0
***************
**** File 1) BEAMS.OL2[NEW,LCS], Page 1 line 173
1) IF(MODE.EQ.3)GO TO 5032
1) C MODE 3 IS FOR ACCENTS ETC.
1) RN(8+IS)=0
**** File 2) BX.F4[NEW,LCS], Page 2 line 180
2) RN(8+IS)=0
***************
**** File 1) BEAMS.OL2[NEW,LCS], Page 1 line 179
1) IF(MODE.EQ.5)GO TO 104
1) IF(STEM.EQ.0)GO TO 503
**** File 2) BX.F4[NEW,LCS], Page 2 line 184
2) IF(STEM.EQ.0)GO TO 503
***************
**** File 1) BEAMS.OL2[NEW,LCS], Page 1 line 226
1) 5060 IF(MODE.EQ.3)GO TO 30
1) C NOW SLUR STARTS
1) IF(JMP)GO TO 504
1) C JMP=-1 MEANS END NOTE OF GROUP
**** File 2) BX.F4[NEW,LCS], Page 2 line 230
2) 5060 IF(JMP)GO TO 504
2) C JMP=-1 MEANS END NOTE OF GROUP
***************
**** File 1) BEAMS.OL2[NEW,LCS], Page 1 line 238
1) 777 IF(MODE.NE.4)GO TO 5061
1) IF(STEM.LE.0)GO TO 5061
1) C AUTOMATIC DIP DIRECTION FOR SLURS WITH AUTO. BEAMS.
**** File 2) BX.F4[NEW,LCS], Page 2 line 240
2) 777 IF(STEM.LE.0)GO TO 5061
2) C AUTOMATIC DIP DIRECTION FOR SLURS WITH AUTO. BEAMS.
***************
**** File 1) BEAMS.OL2[NEW,LCS], Page 1 line 246
1) 477 IF(R(10,MK).EQ.0)GO TO 1077
1) C SKIP NOTES ON ANOTHER STAFF.
1) MK=MK+1
1) GO TO 477
1) 1077 A=19.-R(5,MK)
1) BEAMS.OL2[NEW,LCS] and 2) BX.F4[NEW,LCS] 5-17-78 12:46 pages 1,2
**** File 2) BX.F4[NEW,LCS], Page 2 line 247
2) CC477 IF(R(10,MK).EQ.0)GO TO 1077
2) C SKIP NOTES ON ANOTHER STAFF.
2) CC MK=MK+1
2) CC GO TO 477
2) 477 CONTINUE
2) 1077 A=19.-R(5,MK)
***************
**** File 1) BEAMS.OL2[NEW,LCS], Page 1 line 263
1) IF(MODE.EQ.4)GO TO 550
1) IBR=6
1) C 6=SLUR, 7=BRACK. FOR TRIPLETS, ETC.
1) CC*** NOT NEEDED NOW WITH UPDN FEATURE. IF(STEM.GE.0)NN=-NN
1) IF(IT)GO TO 550
1) C IT=-1=SLUR INTO 1ST NOTE.
1) A=XNOTE(K)
1) C XNOTE IS AMOD(R(4,K),100.)
1) C SAVES LEVEL OF 1ST NOTE.
1) 504 RB=2
1) CS B=AMOD(R(6,K),1.0)
1) CS IF(B.GE.0.5)RB=3.
1) CS IF(B.EQ.0.4)RB=5.
1) C THESE ARE FOR >(.5) AND ∧(.4) ACCENTS
1) IF(NN)RB=-RB
**** File 2) BX.F4[NEW,LCS], Page 2 line 266
2) GO TO 550
2) 504 RB=2
2) IF(NN)RB=-RB
***************
**** File 1) BEAMS.OL2[NEW,LCS], Page 1 line 281
1) IF(MODE.EQ.4)GO TO 519
1) C TO MAKE MINI-BEAMS ON GRACE NOTES WHEN NEEDED.
1) IF(MODE.NE.5)GO TO 513
1) SLUR=0
1) C A FLAG FOR LATER USE.
1) JA=K
1) IF(JA.NE.0)GO TO 451
1) 1451 JA=JA+1
1) IF(R(1,JA).NE.1)GO TO 1451
1) 451 MB=R(5,JA)/10.
1) IF(MB.NE.0)GO TO 450
1) MB=1
1) X=R(4,JA)
1) IF(X.GT.80)X=X-100
1) BEAMS.OL2[NEW,LCS] and 2) BX.F4[NEW,LCS] 5-17-78 12:46 pages 1,2
1) IF(X.GT.6)MB=2
1) 450 IF(UPDN.EQ.0)GO TO 515
1) CCC??? IF(MB.EQ.0)MB=UPDN
1) C MB=0 IF 2ND NOTE IS WITHOUT STEM
1) IF(MB.EQ.UPDN)GO TO 515
1) X=6
1) IF(NN)X=-X
1) CS IF(RB)X=-X
1) RB=RB+X
1) JA=3
1) IF(JMP)JA=6
1) IF(NN)GO TO 204
1) CS IF(RB)GO TO 204
1) IF(UPDN.EQ.2)GO TO 516
1) 204 IF(UPDN.EQ.1)GO TO 516
1) C ABOVE FOR VARIOUS COMBINATIONS OF STEM DIRECTIONS
1) RB=-RB
1) NN=-NN
1) 516 IF(K.GT.1)GO TO 16
1) IF(IT)GO TO 513
1) 16 IF(K.NE.JNTC)GO TO 116
1) IF(N.GT.JNTC)GO TO 513
1) C JUMP IF N=99, BY PASS IF K IS NOT LAST NOTE OF LINE.
1) CCC116 SLUR=1.
1) 116 SLUR=0.5
1) IF(UPDN.EQ.1)SLUR=-SLUR
1) SLUR=SLUR*RSTJ2
1) RN(JA+IS)=RN(JA+IS)+SLUR
1) C THIS NOT DONE IF SLUR TO FIRST NOTE
1) GO TO 513
1) 519 SDIF=R(10,K)
1) IF(SDIF.EQ.0)GO TO 513
1) C JUMP IF IT'S NOT ON DIFF STF.
1) RA=RSTJ2*RNW
1) C NOTE WIDTH = RNW
1) IF(ABS(R(4,K)).LT.80)GO TO 520
1) RA=RA*.6
1) IF(JMP)B=B-100
1) C MINI
1) 520 IF(SDIF.EQ.2)RA=-RA
1) C STAFF ABOVE
1) RN(JA+IS)=POS+RA
1) C ***** THIS CAN BE OFF A LITTLE IN SOME CASES!!******
1) SDIF=SDIF*5
1) IF(SDIF.NE.10)SDIF=20
1) CHANGES 1 TO 20, 2 TO 10.
1) GO TO 513
1) 517 IF(MB.EQ.1)GO TO 513
1) BEAMS.OL2[NEW,LCS] and 2) BX.F4[NEW,LCS] 5-17-78 12:46 pages 1,2
1) IF(RB)RB=-RB
1) GO TO 518
1) 515 UPDN=MB
1) C AUTO SLUR DIP DEPENDS ON STEM DIREC. OF 1ST NOTE. (WHOLE NTS??)
1) IF(NN)GO TO 517
1) IF(MB.NE.1)GO TO 513
1) RB=-RB
1) 518 NN=-NN
1) 513 RN(JB+IS)=B+RB
**** File 2) BX.F4[NEW,LCS], Page 2 line 272
2) 513 RN(JB+IS)=B+RB
***************
**** File 1) BEAMS.OL2[NEW,LCS], Page 1 line 370
1) 5503 RN(8+IS)=-1
1) RN(1+IS)=5
1) IF(IT)RN(4+IS)=RN(5+IS)
1) NN=-NN
1) C IF NN IS NEG. NOW IT MEANS STEM DOWN.(DIP IS UP!)
1) IF(N.EQ.99)GO TO 200
1) C TYPE /n 99/ FOR SLUR BEYOND NOTE HEAD (TO DIFF. PITCH ON NEXT LINE)
1) C /n x/ IS TIE TO SAME NOTE ON NEXT LINE. (X IS ANY NUMBER > LAST NOTE NUM.)
1) IF(MK.EQ.-99)GO TO 200
1) C TYPE /-99 n/ FOR SLUR FROM DIFF. NOTE ON PREVIOUS LINE.
1) C /0 n/ OR /-1 n/ IS TIE FROM SAME NOTE, PREV. LINE
1) C=0
1) C C WILL BE FLAG IN SECTION ON TIES BETWEEN CHORDS (AT 114)
1) AA=XNOTE(K)
1) IF(MK.EQ.JNTC)GO TO 61
1) C JNTC (NOTE COUNT) THE LAST NOTE(OR CHORD) OF INPUT
1) IF(N.EQ.1)GO TO 61
1) IF(IT)GO TO 2114
1) CXX IF(XNOTE(K).NE.A)GO TO 60
1) IF(N-MK.GT.1)GO TO 2114
1) CCC IF(R(5,M).NE.R(5,K))GO TO 65
1) CCC FOR SLUR OVER CHROMATIC CHANGE ON SAME NOTE NAME.
1) C M=1ST NOTE OF SLUR, K=LAST
1) B=R(5,K)
1) IF(AMOD(B,10.0).GT.0)GO TO 65
1) C JUMP IF LAST NOTE HAS ACCI.
1) C JUMP IF NOT ADJACENT NOTE AT SAME PITCH AND NOT 1ST OR LAST.
1) CXX61 C=9
1) CXX IF(JK)C=12
1) CXX IF(RN(6+IS)-RN(3+IS)-C*RSTJ2)GO TO 65
1) C JUMP IF SLUR IS VERY SHORT
1) IF(AA.EQ.A)GO TO 61
1) C NEXT FOR NOTES AT DIFFERENT LEVELS
1) BEAMS.OL2[NEW,LCS] and 2) BX.F4[NEW,LCS] 5-17-78 12:46 pages 1,2
1) IF(B.LT.20)GO TO 161
1) C ARE STEMS THE SAME DIRECTION. JUMP OUT IF SO.
1) IF(R(5,M).GE.20)GO TO 2114
1) GO TO 61
1) 161 IF(R(5,M).LT.20)GO TO 2114
1) 61 IF(IT)A=AA
1) C IT=-1=SLUR INTO 1ST NOTE.
1) CXX C=9
1) CXX IF(JK)C=12
1) C=6
1) IF(JK)C=8
1) C=RN(6+IS)-RN(3+IS)-C*RSTJ2
1) CATCHES VERY SHORT SLURS
1) CXX A=A+.7
1) B=-.7
1) IF(C.OR.A.NE.AA)B=-1.8
1) CXX IF(NN.GT.0)A=A-1.4
1) IF(NN)B=-B
1) C TO RAISE OR LOWER IT .7
1) RN(4+IS)=A+B
1) RN(5+IS)=AA+B
1) CXX RN(5+IS)=A
1) B=-2
1) IF(JK)B=-3
1) C JK=-1 WHEN NOTE IS DOTTED.
1) C THIS PUTS TIE BETWEEN (NOT ABOVE OR BELOW) NTS. NO STEM CHNG.
1) IF(C)B=-1
1) RN(8+IS)=B
1) IF(SLUR.EQ.0)GO TO 65
1) RN(3+IS)=RN(3+IS)-SLUR
1) RN(6+IS)=RN(6+IS)-SLUR
1) C PUSH SLUR BACK TO WHERE IT WAS
1) GO TO 65
1) C NEXT TO SHIFT SLUR IN RE. TO MARKS. STAC., TEN., ACC.
1) C ***********KN = 1ST NOTE, K=LAST NOTE.********
1) 2114 JA=KN
1) JB=4
1) 2503 RB=R(2,JA)
1) IF(RB.EQ.0)GO TO 3503
1) IF(BRK.NE.0)GO TO 6503
1) C IS IT A BRACKET INSTEAD OF A SLUR?
1) IF(RB.EQ.4.OR.RB.EQ.5)GO TO 4503
1) IF(RB.NE.7.AND.RB.NE.9)GO TO 3503
1) 6503 RB=1.5
1) IF(R(5,JA).LT.20)RB=-RB
1) RN(IS+JB)=RN(IS+JB)+RB
1) GO TO 3503
1) 4503 L=R(9,JA)
1) BEAMS.OL2[NEW,LCS] and 2) BX.F4[NEW,LCS] 5-17-78 12:46 pages 1,2
1) C THE POINTER TO P11 WAS SAVED HERE BY 'NEWR'
1) RN(L)=RN(L)+.2
1) 3503 IF(JA.EQ.K)GO TO 60
1) JA=K
1) JB=JB+1
1) GO TO 2503
1) C** 6/16/75 60 IF(STEM.GE.0)GO TO 508
1) 60 IF(STEM.GE.0)GO TO 200
1) IF(MODE.EQ.5)GO TO 200
1) C JUMP IF SLURS**************
1) C NEXT IS STEM INVERTER. SKIP IF AUTOMATIC BEAMS OR 'SU' 'SD' IN USE.
1) JB=1
1) RB=10.
1) IF(NN)GO TO 509
1) C IF NN IS NEG. NOW IT MEANS STEM DOWN.(DIP IS UP!)
1) RB=-RB
1) JB=2
1) 509 DO 507 L=M,K
1) IF(R(1,L).NE.1.)GO TO 507
1) JA=R(5,L)/10.
1) IF(JA.NE.JB)GO TO 507
1) IF(R(10,L).NE.0)GO TO 507
1) C LEAVE NOTE ON OTHER STAFF ALONE.
1) R(5,L)=R(5,L)+RB
1) INVT=0
1) C**********************************************
1) 507 CONTINUE
1) GO TO 200
1) 62 IF(NN)GO TO 64
1) IF(A.EQ.DMAX)GO TO 65
1) AA=B-DMAX
1) GO TO 63
1) 65 AA=0
1) GO TO 63
1) 64 IF(A.EQ.UMAX)GO TO 65
1) AA=UMAX-B
1) 63 RA=RN(6+IS)
1) RB=RN(3+IS)
1) CC DATA BX/25./,BY/.5/,DFAC/6./,CURV/0.9/
1) X=0.9+(RA-RB)/25.+ABS(RN(4+IS)-RN(5+IS))/10.
1) CC X=CURV+(RA-RB)/BX+ABS(RN(4+IS)-RN(5+IS))/10.
1) C CURVE DEPENDS ON LENGTH, TILT AND NOTES BETWEEN.
1) CC IF(AA.GT.0)X=X+AA*BY
1) IF(AA.GT.0)X=X+AA*.5
1) IF(BRK.EQ.0)GO TO 66
1) RN(8+IS)=1
1) RN(3+IS)=RB-.6
1) RB=R(3,K+1)
1) BEAMS.OL2[NEW,LCS] and 2) BX.F4[NEW,LCS] 5-17-78 12:46 pages 1,2
1) C K=END NOTE OF GROUP
1) IF(K.EQ.IZ)RB=200.
1) C IZ IS LAST ITEM IN R(N,M)
1) C**** IF(K.EQ.IRHY)RB=200.
1) C ASSUMES LINE STOPS AT 200. (IT COULD BE LONGER!!)
1) RN(6+IS)=RA+(RB-RA)/2.
1) IBR=7
1) C CHECK THESE NUMBERS↑↑↑↑
1) B=RN(4+IS)
1) BB=RN(5+IS)
1) RA=1
1) IF(A.LT.-1)RA=2.5
1) C CHANGES HEIGHT. MAKES BRACK. IF N>100.
1) IF(NN.GT.0)RA=-RA
1) RN(4+IS)=B+RA
1) RN(5+IS)=BB+RA
1) X=2
1) 66 IF(NN.GT.0)X=-X
1) 510 RN(7+IS)=X
1) IF(MODE.NE.4)GO TO 2514
1) CC RN(9+IS)=0
1) RN(10+IS)=0
**** File 2) BX.F4[NEW,LCS], Page 2 line 289
2) C ***********KN = 1ST NOTE, K=LAST NOTE.********
2) 510 RN(7+IS)=X
2) RN(10+IS)=0
***************
**** File 1) BEAMS.OL2[NEW,LCS], Page 1 line 525
1) IF(JB)CALL BMX(RA)
1) GO TO 514
1) 2514 L=IS
1) CALL UPDATE(IBR)
1) CC IF(M.EQ.K)GO TO 514
1) IF(C.EQ.0)GO TO 514
1) C JUMP OUT IF INTERVENING NOTE. C≠0 = TIE BETWEEN NOTES
1) IF(RN(L+4).NE.RN(L+5))GO TO 514
1) C IS IT LEVEL?
1) B=-RN(IS-2)
1) C CHANGE DIRECTION OF DIP AFTER FIRST SLUR.
1) CZZ RA=1.4
1) RA=.7
1) IF(RN(L+8).EQ.-1)RA=RA+1.3
1) C IS TIE NOT BETWEEN NOTES?
1) IF(NN.GT.0)RA=-RA
1) C DIP DIRECTION. NN+ =DOWN, NN- =UP. REVERSED AFTER 1ST ONE.
1) CZZ RA=XNOTE(M)+RA
1) BEAMS.OL2[NEW,LCS] and 2) BX.F4[NEW,LCS] 5-17-78 12:46 pages 1,2
1) C=-2.
1) IF(RN(L+8).EQ.-3.)C=-3.
1) C PUT TIE BETWEEN NOTES ALWAYS.
1) JA=M
1) JB=K
1) IF(MK)JA=JB
1) C FOR TIES TO 1ST OF LINE
1) IF(N.GT.JNTC)JB=JA
1) C FOR END OF LINE CHORDS JNTC=TOTAL OF NOTES (NOTE COUNT)
1) RC=R(3,JA)
1) 114 JA=JA+1
1) JB=JB+1
1) IF(RC.NE.R(3,JA))GO TO 514
1) CC IF(R(3,JB).NE.POS)GO TO 514
1) C JUMP IF RIGHT-HAND NOTE NOT IN SAME POS.
1) IF(R(1,JA).NE.1)GO TO 514
1) C CATCHES THINGS BETWEEN NOTES
1) IF(R(4,JA).NE.R(4,JB))GO TO 514
1) C LOOKS FOR PARALLEL CHORDS NOTES
1) CRH IF(R(9,JA)+R(9,JB).NE.0)GO TO 514
1) C MAKES SURE THEY ARE CHORD NOTES.
1) A=XNOTE(JA)
1) BB=RA
1) IF(AMOD(A,2.0).EQ.0)BB=BB/2.
1) C MOVE SLUR 1/2 IF IT WOULD LAND ON A SPACE (EVEN NUMS).
1) A=A-BB
1) CZZZ A=XNOTE(JA)-RA
1) CZZ A=XNOTE(JA)-RA+RN(L+5)
1) RN(IS)=6.
1) RN(IS+1)=5.
1) RN(IS+2)=RN(IS-7)
1) RN(IS+3)=RN(IS-6)
1) RN(IS+6)=RN(IS-3)
1) RN(IS+7)=B
1) RN(IS+8)=C
1) RN(IS+4)=A
1) RN(IS+5)=A
1) CALL UPDATE(IBR)
1) GO TO 114
1) 514 J=J+1
**** File 2) BX.F4[NEW,LCS], Page 2 line 294
2) JA=IS
2) C************************************** BMX ***********
2) IF(JB)CALL BMX(RA)
2) IF(JA.NE.IS)GO TO 514
2) IF(JDIF.EQ.0)GO TO 514
2) C FOR NEW COMPOSITE BEAM FEATURE 4/78
2) IF(RA.EQ.1)GO TO 514
1) BEAMS.OL2[NEW,LCS] and 2) BX.F4[NEW,LCS] 5-17-78 12:46 pages 1,2
2) RN(7+KDIF)=X-1
2) RN(10+KDIF)=100
2) RN(8+KDIF)=R(3,JDIF-1)
2) RN(9+KDIF)=R(3,JDIF)
2) 514 J=J+1
***************
**** File 1) BEAMS.OL2[NEW,LCS], Page 1 line 590
1) CC***USE NO NUMBS IN COMMENTS IN MODE 3-5****** IF(VX(J+2).EQ.0)GO TO 614
1) IF(J.LT.50)GO TO 514
**** File 2) BX.F4[NEW,LCS], Page 2 line 312
2) IF(J.LT.50)GO TO 514
***************
**** File 1) BEAMS.OL2[NEW,LCS], Page 1 line 594
1) IF(MODE.NE.5)GO TO 714
1) C NEXT FOR TWO SLURS ON SAME POS. LOOKS AT LEFT SIDE FIRST.
1) NS=LS
1) C NEXT ARE PARAMS 4, 3, 6 OF SLUR. 2ND TIME AROUND USE 5, 6, 3.
1) N=4
1) NA=3
1) NB=6
1) 1314 IF(RN(LS+8).LT.-1)GO TO 714
1) C SKIP OUT IF SLUR IS IN BETWEEN NOTES (P8=-2 OR -3)
1) JS=LS
1) X=1.8
1) IF(RN(LS+7))X=-X
1) A=RN(LS+NA)
1) B=RN(LS+NB)
1) C A AND B ARE THE TWO HORIZ. POSITIONS. RA IS HEIGHT.
1) RA=RN(LS+N)
1) 814 MB=RN(JS)+JS+3
1) C MB IS THE NEXT SLUR
1) IF(MB.LT.IS)GO TO 1514
1) LS=RN(LS)+LS+3
1) C MOVE AHEAD ONE SLUR
1) IF(LS.GE.IS)GO TO 1214
1) GO TO 1314
1) 1514 IF(RN(MB+8).LT.-1)GO TO 1014
1) IF(A.NE.RN(MB+NA))GO TO 1014
1) D=RN(MB+NB)
1) C MAYBE PUT IN SOMETHING HERE TO CATCH SLURS WITH OPPOSITE DIPS.
1) JB=MB
1) IF(N.EQ.5)GO TO 1414
1) IF(B.GT.D)JB=LS
1) GO TO 1114
1) BEAMS.OL2[NEW,LCS] and 2) BX.F4[NEW,LCS] 5-17-78 12:46 pages 1,2
1) 1414 IF(D.GT.B)JB=LS
1) 1114 BB=RN(N+JB)
1) IF(ABS(BB-RA).LT.0.5)RN(N+JB)=BB+X
1) C SHIFT HEIGHT OF SLUR ONLY IF HEIGHT IS CURRENTLY THE SAME.
1) 1014 JS=MB
1) GO TO 814
1) 1214 IF(N.EQ.5)GO TO 714
1) C START AGAIN, LOOK AT RIGHT END OF SLURS NOW
1) N=N+1
1) NA=6
1) NB=3
1) LS=NS
1) GO TO 1314
1) 714 IF(INVT)RETURN
**** File 2) BX.F4[NEW,LCS], Page 2 line 316
2) 714 IF(INVT)RETURN
***************
**** File 1) BEAMS.OL2[NEW,LCS], Page 1 line 646
1) CC552 IF(IREAD.NE.0)GO TO 3501
1) CC CALL TYPE
1) CC WRITE(21,4501)INP
1) CC GO TO 5501
1) CC3501 IF(IREAD.EQ.-1)READ(22,2501)J,INP
1) CC IF(IREAD.EQ.-2)READ(22,4501)INP
1) CC CALL TYPOUT
1) CC5501 CALL LNEND
1) C FOR NEW 'SCORE' CONVENTIONS
1) C TO READ MORE THAN 2 LINES.
1) GO TO 25
1) C FOR 2ND LINE.
1) CC4501 FORMAT(72A1)
1) CC2501 FORMAT(I,72A1)
1) 35 RA=10.
**** File 2) BX.F4[NEW,LCS], Page 2 line 322
2) C TO READ MORE THAN 2 LINES.
2) GO TO 25
2) 35 RA=10.
***************
**** File 1) BEAMS.OL2[NEW,LCS], Page 1 line 675
1) DO 2 L=KN,K
1) IF(R(1,L).NE.1)GO TO 2
1) IF(R(10,L).NE.0)GO TO 2
1) C SKIP NOTES ON ANOTHER STAFF.
1) BB=R(5,L)
1) BEAMS.OL2[NEW,LCS] and 2) BX.F4[NEW,LCS] 5-17-78 12:46 pages 1,2
1) IF(BB.GE.10.)GO TO 12
**** File 2) BX.F4[NEW,LCS], Page 2 line 339
2) RDIF=0
2) C JDIF AND RDIF ARE FOR NEW COMPOSITE BEAM FEATURE 5/78
2) JDIF=0
2) DO 2 L=KN,K
2) IF(R(1,L).NE.1)GO TO 2
2) IF(JDIF.NE.0)GO TO 1212
2) BB=RHY(L)
2) IF(BB.LE.0)GO TO 1212
2) IF(BB.EQ.4./88.)GO TO 1212
2) IF(RDIF.NE.0)GO TO 2212
2) RDIF=BB
2) C NOW WE HAVE FIRST RHYTH. VALUE UNDER BEAM
2) GO TO 1212
2) 2212 IF(RDIF.EQ.BB)GO TO 1212
2) JDIF=L
2) KDIF=IS
2) C FOUND A DIFF. RHYTH. UNDER BEAM
2) CXCX1212 IF(R(10,L).NE.0)GO TO 2
2) C SKIP NOTES ON ANOTHER STAFF.**************?????????????
2) 1212 BB=R(5,L)
2) IF(BB.GE.10.)GO TO 12
***************
**** File 1) BEAMS.OL2[NEW,LCS], Page 1 line 705
1) IT=K
1) C FOR EXTRA BEAMS WITH CHORDS. SAVE IT IN "IT"
1) IF(STEM.GT.0)GO TO 577
1) C *****↑↑↑↑↑↑ ABOVE WAS ".NE." BEFORE 4/30/76. WHY?#@&Xαε
**** File 2) BX.F4[NEW,LCS], Page 2 line 384
2) IT=KN
2) M=3
2) 203 IF(R(10,IT).EQ.0)GO TO 202
2) IF(STEM.EQ.0)GO TO 202
2) C=RNW
2) IF(NN)GO TO 206
2) IF(R(5,IT).LT.20)GO TO 202
2) C=-C
2) GO TO 205
2) 206 IF(R(5,IT).GE.20)GO TO 202
2) 205 IF(ABS(R(4,IT)).GE.80.)C=C*.6
2) C FOR MINI BEAMS
2) RN(M+IS)=RN(M+IS)+C*RSTJ2
2) 202 IF(IT.NE.KN)GO TO 201
2) IT=K
2) M=6
1) BEAMS.OL2[NEW,LCS] and 2) BX.F4[NEW,LCS] 5-17-78 12:46 pages 1,2
2) GO TO 203
2)
2) C FOR EXTRA BEAMS WITH CHORDS. SAVE IT IN "IT"
2) 201 IF(STEM.GT.0)GO TO 577
2) C *****↑↑↑↑↑↑ ABOVE WAS ".NE." BEFORE 4/30/76. WHY?#@&Xαε
***************
**** File 1) BEAMS.OL2[NEW,LCS], Page 1 line 711
1) CXX IF(STEM.GT.0)NN=10.-STEM
1) C SETS AUTO. BEAMS' STEM DIRECTION.
**** File 2) BX.F4[NEW,LCS], Page 2 line 407
2) C SETS AUTO. BEAMS' STEM DIRECTION.
***************
**** File 1) BEAMS.OL2[NEW,LCS], Page 1 line 715
1) IF(SDIF.NE.0)X=SDIF
1) IF(MB)RA=2
**** File 2) BX.F4[NEW,LCS], Page 2 line 410
2) IF(MB)RA=2
***************
**** File 1) BEAMS.OL2[NEW,LCS], Page 1 line 723
1) CC IF(R(9,L).NE.0)GO TO 307
1) IF(R(5,L).GE.10)GO TO 307
**** File 2) BX.F4[NEW,LCS], Page 2 line 417
2) IF(R(5,L).GE.10)GO TO 307
***************
**** File 1) BEAMS.OL2[NEW,LCS], Page 1 line 728
1) 307 IF(R(10,M).EQ.0)GO TO 607
1) M=M+1
1) C SKIP NOTES ON OTHER STAFF
1) GO TO 307
1) 607 A=XNOTE(M)
1) CW307 A=XNOTE(M)
1) C A=NOTE 1.
**** File 2) BX.F4[NEW,LCS], Page 2 line 421
2) 307 CONTINUE
2) 607 A=XNOTE(M)
2) C A=NOTE 1.
***************
**** File 1) BEAMS.OL2[NEW,LCS], Page 1 line 747
1) BEAMS.OL2[NEW,LCS] and 2) BX.F4[NEW,LCS] 5-17-78 12:46 pages 1,2
1) 103 DO 3 M=KN,K
1) IF(R(1,M).NE.1)GO TO 3
1) IF(R(10,M).NE.0)GO TO 3
1) C SKIP NOTES ON OTHER STAFF
1) IF(M.EQ.K)GO TO 107
1) CW IF(R(10,M).NE.0)GO TO 107
1) IF(R(1,M+1).NE.1)GO TO 107
1) C IT ONLY CARES ABOUT NOTES!
1) CC IF(R(9,M+1).EQ.0)GO TO 3
1) IF(R(5,M+1).LT.10)GO TO 3
**** File 2) BX.F4[NEW,LCS], Page 2 line 436
2) 103 IF(STEM.EQ.0)GO TO 603
2) MMS=R(5,KN)/10.
2) DO 703 M=KN+1,K
2) 703 IF(MMS.NE.IFIX(R(5,M)/10.))GO TO 4
2) C SKIP NEXT IF STEMS ARE SPECIFIED IN DIFF. DIRECTIONS. (GRACE NTS??)
2) 603 DO 3 M=KN,K
2) IF(R(1,M).NE.1)GO TO 3
2) CXCXCX IF(STEM.NE.0.AND.R(10,M).NE.0)GO TO 3
2) C SKIP NOTES ON OTHER STAFF
2) IF(M.EQ.K)GO TO 107
2) IF(R(1,M+1).NE.1)GO TO 107
2) C IT ONLY CARES ABOUT NOTES!
2) IF(R(5,M+1).LT.10)GO TO 3
***************
**** File 1) BEAMS.OL2[NEW,LCS], Page 1 line 763
1) IF(MODE.EQ.5)GO TO 55
1) 677 IF(R(10,M).NE.0)GO TO 55
1) C DON'T CHANGE STEM DIR. IF NOTE IS ON OTHER STAFF!!!!
**** File 2) BX.F4[NEW,LCS], Page 2 line 455
2) 677 IF(STEM.NE.0.AND.R(10,M).NE.0)GO TO 55
2) C DON'T CHANGE STEM DIR. IF NOTE IS ON OTHER STAFF!!!!
***************
**** File 1) BEAMS.OL2[NEW,LCS], Page 1 line 795
1) 4 IF(MODE.EQ.5)GO TO 62
1) K=IT
1) C FOR EXTRA BEAMS WITH CHORDS. K WAS SAVED IN "IT"
**** File 2) BX.F4[NEW,LCS], Page 2 line 486
2) 4 K=IT
2) C FOR EXTRA BEAMS WITH CHORDS. K WAS SAVED IN "IT"
***************
**** File 1) BEAMS.OL2[NEW,LCS], Page 1 line 820
1) BEAMS.OL2[NEW,LCS] and 2) BX.F4[NEW,LCS] 5-17-78 12:46 pages 1,2
1) CC446 DIS=(RN(IS+6)-RN(IS+3))/DFAC
1) C FOR TILT LATER -- DFAC IS IN DATA
1) IF(ABS(A-B).LT.DIS)GO TO 143
**** File 2) BX.F4[NEW,LCS], Page 2 line 510
2) C FOR TILT LATER --
2) IF(ABS(A-B).LT.DIS)GO TO 143
***************
**** File 1) BEAMS.OL2[NEW,LCS], Page 1 line 895
1) C NEXT IS FOR ACCENTS AND OTHER MARKS
1) 30 IF(JREP)CALL MARKS(RA)
1) RB=0
1) C%%%%%%%%
1) J=J+1
1) IF(RA.GE.30.AND.RA.LE.35)VX(J+1)=0
1) C THIS ↑↑↑↑ CATCHES FINGERING NUM.(0-5) IT WAS READ IN MARKS.
1) IF(RA.EQ.99)RA=VX(J)
1) C IF STEM IS DOWN OR THERE ARE NOTES BELOW(DBL STP), POSITION
1) C OF ACCENT WILL BE INVERTED.
1) 130 IF(RA.LT.37)GO TO 304
1) C 37=RIT.
1) C=POSIT(VX(J-1))-1.5
1) C '-1.5' PUSHES IT TO LEFT. MAYBE CHANGE ORIGINAL POSITIONS??
1) IF(RA.LE.60.OR.RA.GT.63)GO TO 308
1) C NEXT FOR TREMOLO: TM, TME, TMS, =32ND, 8TH, 16TH
1) NN=11
1) A=8
1) C A IS WDCNT-2
1) B=6
1) C CODE NUM. IS IN B
1) C=C+1.5
1) C FIND POSITION OF THIS NOTE
1) BB=R(4,K)
1) C BB=HEIGHT
1) RC=AMOD(R(7,K),10.0)
1) C LOOK FOR TAILS
1) X=0
1) IF(RA.EQ.61)X=1
1) C RA=61= 8TH NOTE BEAM
1) AA=R(8,K)
1) C TREM. POS. WILL DEPEND ON NOTE POS. AND STEM LENGTH
1) IF(AA.NE.0)GO TO 2309
1) AA=1-X
1) R(8,K)=1.2-X
1) 2309 AA=AA-1
1) C AA = AMOUNT TO BE ADDED OR SUBTRACTED WITH HEIGHT OF NOTE
1) IF(R(5,K).GE.20)GO TO 1309
1) BEAMS.OL2[NEW,LCS] and 2) BX.F4[NEW,LCS] 5-17-78 12:46 pages 1,2
1) C CHECK ON STEM DIRECTION
1) X=-(RA-50)
1) C MAKES -11, -12, -13, ETC.
1) CV IF(RC.EQ.0)GO TO 309
1) CV X=-12
1) CV NO C PUSH TREM UP OR DOWN 2 IF TAIL
1) IF(RC.NE.0)BB=BB-2
1) GO TO 309
1) 1309 X=-(RA-40)
1) C MAKES -21, -22, ETC.
1) AA=-AA
1) IF(RC.NE.0)BB=BB+2
1) 309 BB=BB+AA
1) C OK FOR 16TH AND 32ND - BUT 8TH NEEDS MORE WORK******
1) RN(IS+7)=X
1) RN(IS+6)=0
1) C EXTEND THE STEM
1) RC=0
1) RN(IS+8)=0
1) RN(IS+9)=0
1) RN(IS+10)=0
1) C ABOVE IS TO LEAVE ROOM FOR CHANGE OF TREM TO BE PARALLEL TO OTHER BM.
1) GO TO 305
1) 308 NN=6
1) RC=RA
1) BB=-6
1) A=3
1) B=3
1) IF(XNOTE(K).LT.3)BB=XNOTE(K)-7.5
1) C LOWERS ITEM IF NOTE BELOW STAFF. BUT IS 'K' ALWAYS OK HERE??????
1) IF(RA.LT.99)GO TO 305
1) C NEXT FOR CRESC. & DECRSC. LINES<,>. TYPE /NT1 C+ NT2/ OR /N1.d C- N2.d/
1) C ALSO FOR "8va ----" /NT1 O NT2/
1) NN=8
1) BB=BB+2.5
1) A=5
1) B=4
1) RB=50
1) IF(RA.NE.208)GO TO 306
1) RB=0
1) B=7
1) BB=15
1) C LATER ADD CHECK FOR HEIGHT OF NOTES UNDER 8va.
1) 306 RN(IS+7)=RA-200
1) C MAKES ZERO OR -1 OR 8 IN P7
1) RC=RB
1) C ADDS A NEW ITEM. MP, PP, CRESC., ETC. --CODE 3
1) 305 RN(IS)=A
1) BEAMS.OL2[NEW,LCS] and 2) BX.F4[NEW,LCS] 5-17-78 12:46 pages 1,2
1) RN(IS+1)=B
1) RN(IS+2)=STAFF
1) C PUTS MF, ETC. BETWEEN NOTES. (I HOPE) SEE 'FUNCTION POSIT' BELOW
1) RN(IS+3)=C
1) C C HAS HORIZONTAL POS.
1) RN(IS+4)=BB
1) C DIST. BELOW STAFF
1) RN(IS+5)=RC
1) C THE CODE NUM IN 'CLEFS' LIST
1) IS=IS+NN
1) IF(B.EQ.3.OR.B.EQ.6)GO TO 230
1) CC IF(NN.EQ.6.OR.B.EQ.6)GO TO 230
1) C B=6=TREM. NN=6=WORDS OR LTRS. UNDER STAFF.
1) J=J+1
1) RC=POSIT(VX(J))
1) IF(RB.EQ.0)RC=RC+3
1) C RB=0= 8va
1) RN(IS-2)=RC
1) C THIS IS P6 (POS2 FOR CRESC. LINES)
1) GO TO 514
1) CS304 RB=R(6,K)
1) CS B=10.
1) CS IF(RA.EQ.6)RA=26.
1) C TEMPORARY CHANGE FOR FERMATA*******
1) CS IF(RA.GT.10.)RA=RA/10.
1) CS A=ABS(AMOD(RB,1.))
1) CS IF(A.EQ.0)GO TO 301
1) CS IF(RA.GT.3)GO TO 303
1) CS RB=FLOAT(IFIX(RB))
1) CS RA=RA+A/10.
1) C THIS PUTS 2-DIGIT CODE BEFORE 1-DIGIT CODE.
1) CS GO TO 301
1) CS303 IF(A.LT..3)GO TO 302
1) CS B=100.
1) CS GO TO 301
1) CS302 B=1000.
1) CS301 IF(RB.LT.0)RA=-RA
1) CS R(6,K)=RB+RA/B
1) 304 RB=R(2,K)
1) IF(RA.EQ.6)RA=26.
1) A=RA
1) IF(RB.EQ.0)GO TO 301
1) IF(RB.GE.10)GO TO 303
1) A=A*100
1) GO TO 301
1) 303 RB=RB*100
1) 301 R(2,K)=RB+A
1) C P11 INFO(MARKS) IS TEMPORARILY STORED IN P2 (STAFF# IS IN STAFF)
1) BEAMS.OL2[NEW,LCS] and 2) BX.F4[NEW,LCS] 5-17-78 12:46 pages 1,2
1) 230 A=VX(J)
1) JREP=-1
1) IF(A.EQ.0)GO TO 514
1) C NEXT FOR STRING OF SAME MARK ( /3 12 S/ )
1) IF(A.GT.JNTC)A=JNTC
1) C WON'T PUT MARK BEYOND LAST NOTE
1) JREP=0
1) J=J-1
1) VX(J)=VX(J)+1
1) IF(VX(J).GE.A)VX(J+1)=0
1) J=J-1
1) GO TO 514
1) C USES 4-7,9,11-13 FOR ACC. > FERM. DOT - DNBOW UPBOW HARM.
1) C NOTE#,ACCENT#/N,A/N,A*
1) END
1) FUNCTION NREST(K)
1) COUNTS REST FROM START OF LINE UP TO ITEM K-1 (K IS A NOTE)
1) COMMON /SCM/V(1)
1) NREST=0
1) DO 1 J=1,K-1
1) 1 IF(V(J))NREST=NREST+1
1) END
**** File 2) BX.F4[NEW,LCS], Page 2 line 584
2) END
***************